home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / edmacro.el.z / edmacro.el
Encoding:
Text File  |  1998-05-21  |  24.1 KB  |  751 lines
  1. ;;; edmacro.el --- keyboard macro editor
  2.  
  3. ;; Copyright (C) 1993, 1994, 1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Dave Gillespie <daveg@synaptics.com>
  6. ;;         Hrvoje Niksic <hniksic@srce.hr>  -- XEmacs rewrite
  7. ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
  8. ;; Version: 3.19
  9. ;; Keywords: abbrev, internal
  10.  
  11. ;; This file is part of XEmacs.
  12.  
  13. ;; XEmacs is free software; you can redistribute it and/or modify
  14. ;; it under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17.  
  18. ;; XEmacs is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26. ;; 02111-1307, USA.
  27.  
  28. ;;; Synched up with: FSF 19.34.
  29. ;;; Most of this file has been rewritten for XEmacs, so the
  30. ;;; implementations are out of synch.  The original version depended
  31. ;;; too closely on GNU Emacs key representation and the equivalence of
  32. ;;; characters and integers to be usable.
  33.  
  34. ;;; Commentary:
  35.  
  36. ;;; Usage:
  37. ;;
  38. ;; The `C-x C-k' (`edit-kbd-macro') command edits a keyboard macro
  39. ;; in a special buffer.  It prompts you to type a key sequence,
  40. ;; which should be one of:
  41. ;;
  42. ;;  * RET or `C-x e' (call-last-kbd-macro), to edit the most 
  43. ;;    recently defined keyboard macro.
  44. ;;
  45. ;;  * `M-x' followed by a command name, to edit a named command
  46. ;;    whose definition is a keyboard macro.
  47. ;;
  48. ;;  * `C-h l' (view-lossage), to edit the 100 most recent keystrokes
  49. ;;    and install them as the "current" macro.
  50. ;;
  51. ;;  * any key sequence whose definition is a keyboard macro.
  52. ;;
  53. ;; This file includes a version of `insert-kbd-macro' that uses the
  54. ;; more readable format defined by these routines.
  55. ;;
  56. ;; Also, the `read-kbd-macro' command parses the region as
  57. ;; a keyboard macro, and installs it as the "current" macro.
  58. ;; This and `format-kbd-macro' can also be called directly as
  59. ;; Lisp functions.
  60.  
  61. ;; The `kbd' macro is a shorter-named and more efficient form of
  62. ;; `read-kbd-macro'.  Unlike `read-kbd-macro', it is evaluated at
  63. ;; read-time, and doesn't bring any overhead to compiled programs.  It
  64. ;; is recommended to use in your programs and initializations, as you
  65. ;; needn't know the internal keysym representation.  For example:
  66. ;;
  67. ;; (define-key foo-mode-map (kbd "C-c <up>") 'foo-up)
  68. ;;
  69. ;; is the exact equivalent of
  70. ;;
  71. ;; (define-key foo-mode-map [(control ?c) up] 'foo-up)
  72. ;;
  73.  
  74. ;; Type `C-h m', or see the documentation for `edmacro-mode' below,
  75. ;; for information about the format of written keyboard macros.
  76.  
  77. ;; `edit-kbd-macro' formats the macro with one command per line,
  78. ;; including the command names as comments on the right.  If the
  79. ;; formatter gets confused about which keymap was used for the
  80. ;; characters, the command-name comments will be wrong but that
  81. ;; won't hurt anything.
  82.  
  83. ;; With a prefix argument, `edit-kbd-macro' will format the
  84. ;; macro in a more concise way that omits the comments.
  85.  
  86. ;;; Code:
  87.  
  88. (eval-when-compile
  89.   (require 'cl))
  90.  
  91. (defgroup edmacro nil
  92.   "Keyboard macro editor."
  93.   :group 'keyboard)
  94.  
  95. (defcustom edmacro-eight-bits nil
  96.   "*Non-nil if edit-kbd-macro should leave 8-bit characters intact.
  97. Default nil means to write characters above \\177 in octal notation."
  98.   :type 'boolean
  99.   :group 'edmacro)
  100.  
  101. (defcustom edmacro-format-hook nil
  102.   "*Hook run after formatting the keyboard macro."
  103.   :type 'hook
  104.   :group 'edmacro)
  105.  
  106. (defvar edmacro-finish-hook nil)
  107. (defvar edmacro-store-hook nil)
  108. (defvar edmacro-original-buffer nil)
  109.  
  110. ;;; The user-level commands for editing macros.
  111.  
  112. ;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro)
  113.  
  114. (defvar edmacro-mode-map nil)
  115. (unless edmacro-mode-map
  116.   (setq edmacro-mode-map (make-sparse-keymap))
  117.   (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)
  118.   (define-key edmacro-mode-map "\C-c\C-q" 'edmacro-insert-key))
  119.  
  120. ;;;###autoload
  121. (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook)
  122.   "Edit a keyboard macro.
  123. At the prompt, type any key sequence which is bound to a keyboard macro.
  124. Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
  125. the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by
  126. its command name.
  127. With a prefix argument, format the macro in a more concise way."
  128.   (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP")
  129.   (when (vectorp keys)
  130.     (setq keys (edmacro-events-to-keys keys)))
  131.   (let ((cmd (if (symbolp keys) keys (key-binding keys)))
  132.     (mac nil))
  133.     (cond (store-hook
  134.        (setq mac keys)
  135.        (setq cmd nil))
  136.       ((or (eq cmd 'call-last-kbd-macro)
  137.            (and (arrayp keys)
  138.             (= 1 (length keys))
  139.             (or (eq 'return (aref keys 0))
  140.             (eq ?\r (aref keys 0))
  141.             (equal '(control ?m) (aref keys 0)))))
  142.        (or last-kbd-macro
  143.            (y-or-n-p "No keyboard macro defined.  Create one? ")
  144.            (keyboard-quit))
  145.        (setq mac (or last-kbd-macro []))
  146.        (setq cmd 'last-kbd-macro))
  147.       ((eq cmd 'execute-extended-command)
  148.        (setq cmd (edmacro-minibuf-read "Name of keyboard macro to edit: "))
  149.        (if (string-equal cmd "")
  150.        (error "No command name given"))
  151.        (setq mac (symbol-function cmd)))
  152.       ((eq cmd 'view-lossage)
  153.        (setq mac (recent-keys))
  154.        (setq cmd 'last-kbd-macro))
  155.       ((null cmd)
  156.        (error "Key sequence `%s' is not defined" (key-description keys)))
  157.       ((symbolp cmd)
  158.        (setq mac (symbol-function cmd)))
  159.       (t
  160.        (setq mac cmd)
  161.        (setq cmd nil)))
  162.     (unless (arrayp mac)
  163.       (error "Key sequence `%s' is not a keyboard macro"
  164.          (key-description keys)))
  165.     (message "Formatting keyboard macro...")
  166.     (let ((oldbuf (current-buffer))
  167.       (fmt (edmacro-format-keys mac))
  168.       (fmtv (edmacro-format-keys mac (not prefix)))
  169.       (buf (get-buffer-create "*Edit Macro*")))
  170.       (message "Formatting keyboard macro...done")
  171.       (switch-to-buffer buf)
  172.       (kill-all-local-variables)
  173.       (use-local-map edmacro-mode-map)
  174.       (setq buffer-read-only nil)
  175.       (setq major-mode 'edmacro-mode)
  176.       (setq mode-name "Edit Macro")
  177.       (set (make-local-variable 'edmacro-original-buffer) oldbuf)
  178.       (set (make-local-variable 'edmacro-finish-hook) finish-hook)
  179.       (set (make-local-variable 'edmacro-store-hook) store-hook)
  180.       (erase-buffer)
  181.       (insert ";; Keyboard Macro Editor.  Press C-c C-c to finish; "
  182.           "press C-x k RET to cancel.\n")
  183.       (insert ";; Original keys: " fmt "\n")
  184.       (unless store-hook
  185.     (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n")
  186.     (let ((keys (where-is-internal (or cmd mac))))
  187.       (if keys
  188.           (dolist (key keys)
  189.         (insert "Key: " (edmacro-format-keys key) "\n"))
  190.         (insert "Key: none\n"))))
  191.       (insert "\nMacro:\n\n")
  192.       (save-excursion
  193.     (insert fmtv "\n"))
  194.       (recenter '(4))
  195.       (run-hooks 'edmacro-format-hook))))
  196.  
  197. ;;; The next two commands are provided for convenience and backward
  198. ;;; compatibility.
  199.  
  200. ;;;###autoload
  201. (defun edit-last-kbd-macro (&optional prefix)
  202.   "Edit the most recently defined keyboard macro."
  203.   (interactive "P")
  204.   (edit-kbd-macro 'call-last-kbd-macro prefix))
  205.  
  206. ;;;###autoload
  207. (defun edit-named-kbd-macro (&optional prefix)
  208.   "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'."
  209.   (interactive "P")
  210.   (edit-kbd-macro 'execute-extended-command prefix))
  211.  
  212. ;;;###autoload
  213. (defun read-kbd-macro (start &optional end)
  214.   "Read the region as a keyboard macro definition.
  215. The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
  216. See documentation for `edmacro-mode' for details.
  217. The resulting macro is installed as the \"current\" keyboard macro.
  218.  
  219. In Lisp, may also be called with a single STRING argument in which case
  220. the result is returned rather than being installed as the current macro.
  221. The result will be a vector of keystrokes."
  222.   (interactive "r")
  223.   (if (stringp start)
  224.       (edmacro-parse-keys start)
  225.     (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
  226.  
  227. ;;;###autoload
  228. (defmacro kbd (keys)
  229.   "Convert KEYS to the internal Emacs key representation."
  230.   (read-kbd-macro keys))
  231.  
  232. ;;;###autoload
  233. (defun format-kbd-macro (&optional macro verbose)
  234.   "Return the keyboard macro MACRO as a human-readable string.
  235. This string is suitable for passing to `read-kbd-macro'.
  236. Second argument VERBOSE means to put one command per line with comments.
  237. If VERBOSE is nil, put everything on one line."
  238.   (and macro (symbolp macro) (setq macro (symbol-function macro)))
  239.   (edmacro-format-keys (or macro last-kbd-macro) verbose))
  240.  
  241.  
  242. ;;; Commands for *Edit Macro* buffer.
  243.  
  244. (defun edmacro-finish-edit ()
  245.   (interactive)
  246.   (unless (eq major-mode 'edmacro-mode)
  247.     (error
  248.      "This command is valid only in buffers created by `edit-kbd-macro'"))
  249.   (run-hooks 'edmacro-finish-hook)
  250.   (let ((cmd nil) (keys nil) (no-keys nil)
  251.     (top (point-min)))
  252.     (goto-char top)
  253.     (let ((case-fold-search nil))
  254.       (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)")
  255.             t)
  256.            ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
  257.             (when edmacro-store-hook
  258.               (error "\"Command\" line not allowed in this context"))
  259.             (let ((str (buffer-substring (match-beginning 1)
  260.                          (match-end 1))))
  261.               (unless (equal str "")
  262.             (setq cmd (and (not (equal str "none"))
  263.                        (intern str)))
  264.             (and (fboundp cmd) (not (arrayp (symbol-function cmd)))
  265.                  (not (y-or-n-p
  266.                    (format "Command %s is already defined; %s"
  267.                        cmd "proceed? ")))
  268.                  (keyboard-quit))))
  269.             t)
  270.            ((looking-at "Key:\\(.*\\)$")
  271.             (when edmacro-store-hook
  272.               (error "\"Key\" line not allowed in this context"))
  273.             (let ((key (edmacro-parse-keys
  274.                 (buffer-substring (match-beginning 1)
  275.                           (match-end 1)))))
  276.               (unless (equal key [])
  277.             (if (equal key [?n ?o ?n ?e])
  278.                 (setq no-keys t)
  279.               (push key keys)
  280.               (let ((b (key-binding key)))
  281.                 (and b (commandp b) (not (arrayp b))
  282.                  (or (not (fboundp b))
  283.                      (not (arrayp (symbol-function b))))
  284.                  (not (y-or-n-p
  285.                        (format
  286.                     "Key `%s' is already defined; %s"
  287.                     (edmacro-format-keys key)
  288.                     "proceed? ")))
  289.                  (keyboard-quit))))))
  290.             t)
  291.            ((looking-at "Macro:[ \t\n]*")
  292.             (goto-char (match-end 0))
  293.             nil)
  294.            ((eobp) nil)
  295.            (t (error "Expected a `Macro:' line")))
  296.     (forward-line 1))
  297.       (setq top (point)))
  298.     (let* ((buf (current-buffer))
  299.        (str (buffer-substring top (point-max)))
  300.        (modp (buffer-modified-p))
  301.        (obuf edmacro-original-buffer)
  302.        (store-hook edmacro-store-hook))
  303.       (unless (or cmd keys store-hook (equal str ""))
  304.     (error "No command name or keys specified"))
  305.       (when modp
  306.     (when (buffer-name obuf)
  307.       (set-buffer obuf))
  308.     (message "Compiling keyboard macro...")
  309.     (let ((mac (edmacro-parse-keys str)))
  310.       (message "Compiling keyboard macro...done")
  311.       (if store-hook
  312.           (funcall store-hook mac)
  313.         (when (eq cmd 'last-kbd-macro)
  314.           (setq last-kbd-macro (and (> (length mac) 0) mac))
  315.           (setq cmd nil))
  316.         (when cmd
  317.           (if (= (length mac) 0)
  318.           (fmakunbound cmd)
  319.         (fset cmd mac)))
  320.         (if no-keys
  321.         (when cmd
  322.           (loop for key in (where-is-internal cmd) do
  323.             (global-unset-key key)))
  324.           (when keys
  325.         (if (= (length mac) 0)
  326.             (loop for key in keys do (global-unset-key key))
  327.           (loop for key in keys do
  328.             (global-set-key key (or cmd mac)))))))))
  329.       (kill-buffer buf)
  330.       (when (buffer-name obuf)
  331.     (switch-to-buffer obuf)))))
  332.  
  333. (defun edmacro-insert-key (key)
  334.   "Insert the written name of a key in the buffer."
  335.   (interactive "kKey to insert: ")
  336.   (if (bolp)
  337.       (insert (edmacro-format-keys key t) "\n")
  338.     (insert (edmacro-format-keys key) " ")))
  339.  
  340. (defun edmacro-mode ()
  341.   "\\<edmacro-mode-map>Keyboard Macro Editing mode.  Press
  342. \\[edmacro-finish-edit] to save and exit.
  343. To abort the edit, just kill this buffer with \\[kill-buffer] RET.
  344.  
  345. Press \\[edmacro-insert-key] to insert the name of any key by typing the key.
  346.  
  347. The editing buffer contains a \"Command:\" line and any number of
  348. \"Key:\" lines at the top.  These are followed by a \"Macro:\" line
  349. and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'.
  350.  
  351. The \"Command:\" line specifies the command name to which the macro
  352. is bound, or \"none\" for no command name.  Write \"last-kbd-macro\"
  353. to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]).
  354.  
  355. The \"Key:\" lines specify key sequences to which the macro is bound,
  356. or \"none\" for no key bindings.
  357.  
  358. You can edit these lines to change the places where the new macro
  359. is stored.
  360.  
  361.  
  362. Format of keyboard macros during editing:
  363.  
  364. Text is divided into \"words\" separated by whitespace.  Except for
  365. the words described below, the characters of each word go directly
  366. as characters of the macro.  The whitespace that separates words
  367. is ignored.  Whitespace in the macro must be written explicitly,
  368. as in \"foo SPC bar RET\".
  369.  
  370.  * The special words RET, SPC, TAB, DEL, BS, LFD, ESC, and NUL represent
  371.    special control characters.  The words must be written in uppercase.
  372.  
  373.  * A word in angle brackets, e.g., <return>, <down>, or <f1>, represents
  374.    a function key.  (Note that in the standard configuration, the
  375.    function key <return> and the control key RET are synonymous.)
  376.    You can use angle brackets on the words RET, SPC, etc., but they
  377.    are not required there.
  378.  
  379.  * Keys can be written by their ASCII code, using a backslash followed
  380.    by up to six octal digits.  This is the only way to represent keys
  381.    with codes above \\377.
  382.  
  383.  * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt),
  384.    H- (hyper), and s- (super) may precede a character or key notation.
  385.    For function keys, the prefixes may go inside or outside of the
  386.    brackets:  C-<down> = <C-down>.  The prefixes may be written in
  387.    any order:  M-C-x = C-M-x.
  388.  
  389.    Prefixes are not allowed on multi-key words, e.g., C-abc, except
  390.    that the Meta prefix is allowed on a sequence of digits and optional
  391.    minus sign:  M--123 = M-- M-1 M-2 M-3.
  392.  
  393.  * The `^' notation for control characters also works:  ^M = C-m.
  394.  
  395.  * Double angle brackets enclose command names:  <<next-line>> is
  396.    shorthand for M-x next-line RET.
  397.  
  398.  * Finally, REM or ;; causes the rest of the line to be ignored as a
  399.    comment.
  400.  
  401. Any word may be prefixed by a multiplier in the form of a decimal
  402. number and `*':  3*<right> = <right> <right> <right>, and
  403. 10*foo = foofoofoofoofoofoofoofoofoofoo.
  404.  
  405. Multiple text keys can normally be strung together to form a word,
  406. but you may need to add whitespace if the word would look like one
  407. of the above notations:  `; ; ;' is a keyboard macro with three
  408. semicolons, but `;;;' is a comment.  Likewise, `\\ 1 2 3' is four
  409. keys but `\\123' is a single key written in octal, and `< right >'
  410. is seven keys but `<right>' is a single function key.  When in
  411. doubt, use whitespace."
  412.   (interactive)
  413.   (error "This mode can be enabled only by `edit-kbd-macro'"))
  414. (put 'edmacro-mode 'mode-class 'special)
  415.  
  416.  
  417. (defun edmacro-int-char (int)
  418.   (if (fboundp 'int-char)
  419.       (int-char int)
  420.     int))
  421.  
  422. (defvar edmacro-read-history nil)
  423.  
  424. ;; Completing read on named keyboard macros only.
  425. (defun edmacro-minibuf-read (prompt)
  426.   (intern (completing-read
  427.        prompt obarray
  428.        (lambda (arg)
  429.          (and (commandp arg)
  430.           (vectorp (symbol-function arg))))
  431.        t nil 'edmacro-read-history)))
  432.  
  433.  
  434. (defvar edmacro-char-to-word
  435.   '((?\0 . "NUL")
  436.     (?\r . "RET")
  437.     (?\n . "LFD")
  438.     (?\t . "TAB")
  439.     (?\e . "ESC")
  440.     (?\  . "SPC")
  441.     (?\C-? . "DEL")))
  442.  
  443. (defvar edmacro-modifiers
  444.   '(("C" . control)
  445.     ("M" . meta)
  446.     ("S" . shift)
  447.     ("Sh" . shift)
  448.     ("A" . alt)
  449.     ("H" . hyper)
  450.     ("s" . super)))
  451.  
  452. ;;; Parsing a human-readable keyboard macro.
  453.  
  454. ;; In XEmacs version of edmacro, edmacro-parse-keys always returns a
  455. ;; vector.  edmacro-format-keys accepts a vector (but works with a
  456. ;; string too).
  457. (defun edmacro-parse-keys (string)
  458.   (let* ((pos 0)
  459.      (case-fold-search nil)
  460.      res)
  461.     (while (and (< pos (length string))
  462.         (string-match "[^ \t\r\n\f]+" string pos))
  463.       (let ((word (substring string (match-beginning 0) (match-end 0))))
  464.     (setq pos (match-end 0))
  465.     (if (or (equal word "REM") (string-match "^;;" word))
  466.         ;; Comment (discard to EOL) .
  467.         (setq pos (string-match "$" string pos))
  468.       (push (edmacro-parse-word word) res))))
  469.     (mapvector 'identity (apply 'nconc (nreverse res)))))
  470.  
  471. ;; Parse a "word".
  472. (defun edmacro-parse-word (word)
  473.   (let ((force-sym nil)
  474.     (times 1)
  475.     abbr)
  476.     (when (string-match "\\([0-9]+\\)\\*." word)
  477.       (setq times (string-to-int (substring word 0 (match-end 1))))
  478.       (setq word (substring word (1+ (match-end 1)))))
  479.     (when (string-match "^<\\([^<>]+\\)>$" word)
  480.       (setq word (match-string 1 word))
  481.       (setq force-sym t))
  482.     (let* ((word-to-sym '(("NUL" . ?\0)
  483.               ("RET" . return)
  484.               ("LFD" . linefeed)
  485.               ("TAB" . tab)
  486.               ("ESC" . escape)
  487.               ("SPC" . space)
  488.               ("BS" . backspace)
  489.               ("DEL" . delete)))
  490.        (conv (lambda (arg)
  491.            ;; string-to-symbol-or-char converter
  492.            (if (= (length arg) 1)
  493.                (aref arg 0)
  494.              (if (string-match "^<\\([^>]+\\)>$" arg)
  495.              (setq arg (match-string 1 arg)))
  496.              (let ((match (assoc arg word-to-sym)))
  497.                (if match
  498.                (cdr match)
  499.              (intern arg))))))
  500.        (conv-chars (lambda (arg)
  501.              (let ((match (assoc arg edmacro-char-to-word)))
  502.                (if match
  503.                    (cdr (assoc (cdr match) word-to-sym))
  504.                  arg))))
  505.        (add
  506.         (cond
  507.          ((string-match "^\\\\[0-7]+" word)
  508.           ;; Octal value of character.
  509.           (list
  510.            (edmacro-int-char
  511.         (hexl-octal-string-to-integer (substring word 1)))))
  512.          ((string-match "^<<.+>>$" word)
  513.           ;; Extended command.
  514.           (nconc
  515.            (list
  516.         (if (eq (key-binding [(meta x)])
  517.             'execute-extended-command)
  518.             '(meta x)
  519.           (or (car (where-is-internal
  520.                 'execute-extended-command))
  521.               '(meta x))))
  522.            (mapcar conv-chars (concat (substring word 2 -2) "\r"))))
  523.          ((setq abbr (assoc word word-to-sym))
  524.           ;; Convert to symbol.
  525.           (list (cdr abbr)))
  526.          ((string-match "^\\^" word)
  527.           ;; ^X == C-x
  528.           (if (= (length word) 2)
  529.           `((control ,(aref word 1)))
  530.         (mapcar 'identity word)))
  531.          ((string-match "^M--?[0-9]+$" word)
  532.           ;; Special case: M- followed by an optional hyphen and
  533.           ;; one or more digits
  534.           (mapcar (lambda (digit)
  535.             (list 'meta digit))
  536.               (substring word 2)))
  537.          ((string-match "^\\([MCSsAH]\\|Sh\\)-" word)
  538.           ;; Parse C-* and stuff
  539.           (let ((pos1 0)
  540.             (r1 nil)
  541.             follow curpart prefix)
  542.         (while (progn (setq curpart (substring word pos1))
  543.                   (string-match "^\\([MCSsAH]\\|Sh\\)-"
  544.                         curpart))
  545.           (setq prefix (assoc (match-string 1 curpart)
  546.                       edmacro-modifiers))
  547.           (push (cdr prefix) r1)
  548.           (incf pos1 (1+ (length (car prefix)))))
  549.         (setq follow (substring word pos1))
  550.         (if (equal follow "")
  551.             ;; we've got something like "C-M-" -- just let it be,
  552.             ;; because of the way `edmacro-format-keys' works.
  553.             (mapcar 'identity word)
  554.           (list (nconc (nreverse r1) (list (funcall conv follow)))))))
  555.          (force-sym
  556.           ;; This must be a symbol
  557.           (list (intern word)))
  558.          (t
  559.           ;; Characters
  560.           (mapcar conv-chars word))))
  561.        (new nil))
  562.        (loop repeat times do (setq new (append add new)))
  563.        new)))
  564.  
  565. ;; Convert the keypress events in vector x to keys, and return a
  566. ;; vector of keys.  If a list element is not a keypress event, ignore
  567. ;; it.  `events-to-keys' won't quite cut it here, as it is buggy.
  568. (defun edmacro-events-to-keys (x &optional list)
  569.   (let (new)
  570.     (mapc (lambda (el)
  571.         (cond ((key-press-event-p el)
  572.            (push (let ((mods (event-modifiers el)))
  573.                (if mods
  574.                    (append mods (list (event-key el)))
  575.                  (event-key el)))
  576.              new))
  577.           ((or (characterp el)
  578.                (symbolp el)
  579.                (listp el))
  580.            (push el new))))
  581.       x)
  582.     (setq new (nreverse new))
  583.     (if list
  584.     new
  585.       (mapvector 'identity new))))
  586.  
  587. ;; Collapse a list of keys into a list of function keys, if any.
  588. (defun edmacro-fkeys (keys)
  589.   (let (new k lookup)
  590.     (while keys
  591.       (setq k (nconc k (list (car keys))))
  592.       (setq lookup (lookup-key function-key-map (mapvector 'identity k)))
  593.       (cond ((vectorp lookup)
  594.          (push (mapcar 'identity lookup) new)
  595.          (setq k nil))
  596.         ((keymapp lookup)
  597.          nil)
  598.         ((null lookup)
  599.          (push k new)
  600.          (setq k nil))
  601.         (t
  602.          (setq k nil)))
  603.       (pop keys))
  604.     (when (keymapp lookup)
  605.     (push k new))
  606.     (apply 'nconc (nreverse new))))
  607.  
  608. ;; Convert a character or symbol to string.
  609. (defun edmacro-conv (char-or-sym add-<>)
  610.   (let ((char-to-word '((?\0 . "NUL")
  611.             (?\r . "RET")
  612.             (?\n . "LFD")
  613.             (?\t . "TAB")
  614.             (?\e . "ESC")
  615.             (?\  . "SPC")
  616.             (?\C-? . "DEL")))
  617.     (symbol-to-char '((return . ?\r)
  618.               (linefeed . ?\n)
  619.               (space . ?\ )
  620.               (delete . ?\C-?)
  621.               (tab . ?\t)
  622.               (escape . ?\e))))
  623.     (if (symbolp char-or-sym)
  624.     (if (= (length (symbol-name char-or-sym)) 1)
  625.         (setq char-or-sym (aref (symbol-name char-or-sym) 0))
  626.       (let ((found (assq char-or-sym symbol-to-char)))
  627.         (if found
  628.         (setq char-or-sym (cdr found))))))
  629.     ;; Return:
  630.     (cons (symbolp char-or-sym)
  631.       (if (symbolp char-or-sym)
  632.           (if add-<>
  633.           (concat "<" (symbol-name char-or-sym) ">")
  634.         (symbol-name char-or-sym))
  635.         (let ((found (assq char-or-sym char-to-word)))
  636.           (cond (found
  637.              (cdr found))
  638.             ((< char-or-sym 128)
  639.              (single-key-description char-or-sym))
  640.             ((and edmacro-eight-bits
  641.               (>= char-or-sym 128))
  642.              (char-to-string char-or-sym))
  643.             (t
  644.              (format "\\%o" (edmacro-int-char char-or-sym)))))))))
  645.  
  646. (defun edmacro-format-1 (keys command times togetherp)
  647.   (let ((res "")
  648.     (start keys)
  649.     el)
  650.     (while keys
  651.       (when (not (or togetherp (eq start keys)))
  652.     (callf concat res " "))
  653.       (if (> times 1)
  654.       (setq res (concat (format "%d*" times) res)))
  655.       (setq el (car keys))
  656.       (callf concat res
  657.     (cond ((listp el)
  658.            (let ((my ""))
  659.          (if (or
  660.               (let (cnv)
  661.             (while el
  662.               (let ((found (find (car el) edmacro-modifiers
  663.                          :key 'cdr)))
  664.                 (callf concat my
  665.                   (if found
  666.                   (concat (car found) "-")
  667.                 (setq cnv (edmacro-conv (car el) nil))
  668.                 (cdr cnv))))
  669.               (pop el))
  670.             (car cnv))
  671.               (> times 1))
  672.              (concat "<" my ">")
  673.            my)))
  674.           (t
  675.            (cdr (edmacro-conv el t)))))
  676.       (and (cdr keys)
  677.        (memq (car keys) '(?- '- ?> ?^))
  678.        (callf concat res " "))
  679.       (pop keys))
  680.     (if command
  681.     (callf concat res
  682.       (make-string (max (- 3 (/ (length res) tab-width)) 1) ?\t)
  683.       ";; "
  684.       (symbol-name command)
  685.       (if togetherp (format " * %d" (length start)))))
  686.     res))
  687.  
  688. (defsubst edmacro-seq-equal (seq1 seq2)
  689.   (while (and seq1 seq2
  690.           (equal (car seq1) (car seq2)))
  691.     (pop seq1)
  692.     (pop seq2))
  693.   (not seq1))
  694.  
  695. ;;; Formatting a keyboard macro as human-readable text.
  696.  
  697. (defun edmacro-format-keys (macro &optional verbose)
  698.   ;; If we're dealing with events, convert them to symbols first;
  699.   ;; Then, collapse them into function keys, if possible.
  700.   (setq macro (edmacro-fkeys (edmacro-events-to-keys macro t)))
  701.   (let ((res ""))
  702.     (while macro
  703.       (let (key lookup (times 1) self-insert-p)
  704.     (loop
  705.      do (setq key (nconc key (list (car macro)))
  706.           macro (cdr macro)
  707.           lookup (lookup-key global-map (mapvector
  708.                          'identity key)))
  709.      while (and macro lookup (not (commandp lookup))))
  710.     ;; keyboard macro
  711.     (if (vectorp lookup)
  712.         (setq lookup nil))
  713.     (if (and (eq lookup 'self-insert-command)
  714.          (= (length key) 1)
  715.          (not (memq (car key)
  716.                 '(?\  ?\r ?\n space return linefeed tab))))
  717.         (while (and (< (length key) 23)
  718.             (eq (lookup-key global-map (car macro))
  719.                 'self-insert-command)
  720.             (not (memq
  721.                   (car macro)
  722.                   '(?\  ?\r ?\n space return linefeed tab))))
  723.           (setq key (nconc key (list (car macro)))
  724.             macro (cdr macro)
  725.             self-insert-p t))
  726.       (let ((keysize (length key)))
  727.         (while (edmacro-seq-equal key macro)
  728.           (setq macro (nthcdr keysize macro))
  729.           (incf times))))
  730.     (if (or self-insert-p
  731.         (null (cdr key))
  732.         (= times 1))
  733.         (callf concat res
  734.           (edmacro-format-1 key (if verbose lookup
  735.                       nil)
  736.                 times self-insert-p)
  737.           (and macro (if verbose "\n" " ")))
  738.       (loop
  739.        repeat times
  740.        do
  741.        (callf concat res
  742.          (edmacro-format-1 key (if verbose lookup
  743.                      nil)
  744.                    1 self-insert-p)
  745.          (and macro (if verbose "\n" " ")))))))
  746.     res))
  747.  
  748. (provide 'edmacro)
  749.  
  750. ;;; edmacro.el ends here
  751.